Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d3/dbmail.arc/ML0460.PRG

Text File | 1988-06-19 | 5.1 KB | 200 lines

NOTE ML0460 - MESSAGE TEXT ON HANDLING DUPLICATES    10/1/84
ERASE
@ 1,2 SAY 'U P D A T E   M A I L   L I S T   W I T H   S E L E C T E D   R E C O R D S'
@ 3,10 SAY 'This  Routine Selects Records from the Current Mail List and'
@ 4,10 say 'Adds the to a Target Mailing List.'
@ 6,10 SAY 'Both  Lists  Must have been Created by this  System  or  the '
@ 7,10 SAY 'Update  Routine  will Self Destruct (quietly) and Leave  You '
@ 8,10 SAY 'with a Target File Badly in Need of Repairs.  A Word to  the '
@ 9,10 SAY 'Wise  . . . .'
@ 11,10 SAY 'The  Target Mail List may Easily be Built Using Option 1  on '
@ 12,10 SAY 'this Menu, Create a New Mail List File. The Target Mail List '
@ 13,10 SAY 'may  also  be  an Existing Mail List File that You  Wish  to '
@ 14,10 SAY 'Update with Data from Another List.'
@ 16,10 SAY 'The  Target Mail List May also be used as a Device to  Simu-'
@ 17,10 SAY 'late  the  Parentheses  Function that Is  Missing  from  the '
@ 18,10 SAY 'Boolean Select Menu Option. Briefly, the Target Mail List is '
@ 19,10 SAY 'repeatedly  updated for Selections off the Master  List.  In '
@ 20,10 SAY 'this case,  duplicates would,  in all likelihood,  be copied '
@ 21,10 SAY 'onto the Target Mail List.'
WAIT
ERASE
@ 3,2 SAY 'U P D A T E   M A I L   L I S T   W I T H   S E L E C T E D   R E C O R D S'
@ 6,10 SAY 'The  User has Several Options on the Handling  of  Duplicate '
@ 7,10 SAY 'Records on the Target Mail List:'
@ 9,10 SAY '     1. Do NOT  Add Selected Records that have the Same  Rec '
@ 10,10 SAY '          Id as a Record on the Target Mail List;'
@ 12,10 SAY '     2. Assign   NEW  Rec  Id s  to  Selected  Records  with '
@ 13,10 SAY '          Duplicate Rec Id s;'
@ 15,10 SAY '     3. Do Not  CHECK  for Duplicate Rec Id s.  This  is  an '
@ 16,10 SAY '          Extremely Dangerous Option to Choose. For Example, '
@ 17,10 SAY '          the  Second Record with a Duplicate Rec  Id  would '
@ 18,10 SAY '          Inaccessible  through  the Enter/Update Option  on '
@ 19,10 SAY '          the Main Menu.'
STORE 1    TO DDEL
STORE F    TO EXIT
DO WHILE .NOT.EXIT
CLEAR GETS
@ 21,10 SAY 'Enter Selection for Handling Duplicate Rec Id s' GET DDEL PICTURE '99'
READ
STORE DDEL>0 .AND. DDEL<4    TO EXIT
IF .NOT.EXIT
    @ 23,15 SAY 'Response Must Be 1, 2 or 3. Please Reenter.'
    ENDIF
ENDDO
ERASE
@ 3,2 SAY 'U P D A T E   M A I L   L I S T   W I T H   S E L E C T E D   R E C O R D S'
@ 7,10 SAY 'Enter Name of Target Mail List to Receive Selected Records.'
STORE '                    '    TO FIL
@ 8,20 GET FIL PICTURE '!!!!!!!!!!!!!!!!!!!!'
READ
CLEAR GETS
STORE TRIM(FIL)    TO FIL
IF FIL=' '.AND. LEN(FIL)=1
    RELEASE DDEL,FIL
    RETURN
    ENDIF
IF LEN(FIL)-@(':',FIL)<8
    ?
    ? 'PREPARE DEVICE WITH TARGET LIST FILE FOR PROCESSING. Press any key when ready.'
    WAIT
    RESET
    STORE FILE('&FIL..DBF')    TO XXD
    IF .NOT.XXD
        ?
        ? 'TARGET LIST FILE &FIL NOT FOUND. Do you want to Create it at this Time?.'
        ACCEPT 'Enter Response (Y/N) ' TO RESP
        IF !(RESP)='Y'
            ?
            ACCEPT 'ENTER DESCRIPTION OF TARGET FILE' TO DESCR
            USE ML0400
            COPY TO &FIL
            USE &FIL
            APPEND BLANK
            REPLACE RECID WITH 0;
                INST WITH DESCR
            DELETE
            INDEX ON RECID TO &FIL
            USE
            ? 'NEW TARGET MAILING LIST FILE &FIL INITIALIZED.'
        ELSE
            RELEASE XXD,FIL,DDEL,RESP
            RETURN
            ENDIF
    ELSE
        IF .NOT.FILE('&FIL..NDX')
            ?
            ? 'INDEXING TARGET MAILING LIST FILE. Please wait.'
            SET TALK ON
            USE &FIL
            INDEX ON RECID TO &FIL
            SET TALK OFF
            USE
            ENDIF
        ENDIF
ELSE
    ?
    ? 'TARGET MAILING LIST FILE NAME MORE THAN 7 CHARACTERS IN LENGTH.'
    ? '    Press any key to continue.'
    WAIT
    RELEASE FIL,DDEL,XXD
    RETURN
    ENDIF
ENDCASE

USE &FDEV
IF OPT=1
    DO ML0201
    ENDIF
IF OPT=2
    DO ML0202
    ENDIF
IF OPT=3
    DO ML0203
    IF .NOT.FILE('MLSUB1.DBF')
        DO ML0441
        RETURN
        ENDIF
    ENDIF

SELECT PRIMARY
USE MLSUB1
GOTO BOTTOM
?
? #
?? ' RECORDS SELECTED.'

IF #=0
    ?
    ? 'NO Records Selected for Update. Press Any Key to Continue.'
    DO ML0441
    WAIT
    RETURN
    ENDIF

?
ACCEPT 'Do you wish to continue? (Y/N) ' TO RESP
IF !(RESP)='N'
    DO ML0441
    RETURN
    ENDIF

IF DDEL<3

SELECT SECONDARY
USE &FIL INDEX &FIL
GOTO BOTTOM
STORE RECID+1    TO NID
SELECT PRIMARY
GOTO TOP
ERASE
@ 10,10 SAY 'Checking Selected Records for Duplicate Rec Id s.'
@ 14,10 SAY '   0 Selected Records Processed.'

DO WHILE .NOT.EOF
STORE STR(RECID,4)    TO KEY
SELECT SECONDARY
FIND &KEY
IF #>0
    STORE *    TO DREC
    SELECT PRIMARY
    IF DDEL=1
        IF DREC
            SELECT SECONDARY
            RECALL
            SELECT PRIMARY
            ENDIF
        DELETE
    ELSE
        REPLACE RECID    WITH NID
        STORE NID+1    TO NID
        ENDIF
    ENDIF
SELECT PRIMARY
@ 14,10 SAY # USING '9999'
SKIP
ENDDO

    ENDIF {ddel<3}
SELECT SECONDARY
USE
SELECT PRIMARY
USE &FIL
@ 17,10 SAY 'Updating Target File with Selected Records.'
SET TALK ON
APPEND FROM MLSUB1
@ 17,10 SAY 'Update complete.  Reindexing Target File.    '
INDEX ON RECID TO &FIL
SET TALK OFF
USE
DELETE FILE MLSUB1
RELEASE XXD,FIL,DDEL
RETURN

INDEX ON RECID TO &FIL
SET TALK OFF
USE
DELETE FILE MLSUB1
RELEASE XXD,FIL,DDEL
RETURN